home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / MYUTIL / SHAPECNV.OLD < prev    next >
Encoding:
Text File  |  1994-05-14  |  3.3 KB  |  108 lines
  1. MODULE ShpConvert;
  2. (*$E MOS *) IMPORT TOSIO;
  3.  
  4. FROM SYSTEM IMPORT ADR,CADR,ADDRESS,WORD,BYTE,ASSEMBLER;
  5. FROM GrafBase   IMPORT Point;
  6. FROM LineA IMPORT PutPixel, FilledRectangle;
  7. FROM Files IMPORT Open, EOF, Access, Close,File,State, Create, replaceOld;
  8. FROM Binary IMPORT ReadBytes, ReadByte, WriteBytes, ReadBlock,Seek,SeekMode;
  9. FROM InOut IMPORT WriteString,WriteLn,Read,WriteInt;
  10. FROM Strings IMPORT Length;
  11. FROM Storage IMPORT ALLOCATE, DEALLOCATE;
  12.  
  13. PROCEDURE Assert (b: BOOLEAN; x: ADDRESS);
  14.   END Assert;
  15.  
  16. CONST
  17.   bd=8; bw=320; bh=1024+64;
  18.   destWidth=320+64+64;
  19.  
  20. VAR
  21.   graphicsBase:ADDRESS;
  22.  
  23. VAR
  24.   ch: CHAR;
  25.   inFile, out1File,out2File,colFile:File;
  26.   b:BYTE;
  27.   c:CARDINAL;
  28.   colStart,howMuch,colors,line,row,words,xDim,yDim,x,y,d,count,minPlot,
  29.     maxPlot:INTEGER;
  30.   inName,out1Name,out2Name,colName,string:ARRAY [0..255] OF CHAR;
  31.   skip,long:LONGINT;
  32.   dummy:BOOLEAN;
  33.   start:ADDRESS;
  34.   color:ARRAY [0..2] OF BYTE;
  35.   wordPtr:POINTER TO WORD;
  36.   bitSet:BITSET;
  37.   card:CARDINAL;
  38.   colorTab:ARRAY [0..1023] OF ARRAY [0..2] OF BYTE;
  39.   shape: ADDRESS; (* Aufbau: Immer jew. 4 Byte f. Maske und 4 f. Shape *)
  40.  
  41. PROCEDURE SetPix (x,y,col: CARDINAL);
  42.   VAR c: CARDINAL; pc: POINTER TO CHAR;
  43.   BEGIN
  44.     IF x >= ORD(xDim) THEN HALT END;
  45.     IF y >= ORD(yDim) THEN HALT END;
  46.     c:= col; IF c # 0 THEN c:= 1 END;
  47.     PutPixel (Point{x,y}, c);
  48.     IF c = 0 THEN c:= 255 ELSE c:= 0 END;
  49.     pc:= shape + LONG (x DIV 4 * 8 + x MOD 4) + 2 * LONG (y) * LONG (ORD(xDim));
  50.     pc^:= CHR(c); (* Maske *)
  51.     INC (pc,4);
  52.     pc^:= CHR(col);
  53.   END SetPix;
  54.  
  55. BEGIN
  56.   inName:= "F:\COMMON.SHP";
  57.   out1Name:= "A:\COMMON.SHA";
  58.   skip:= 0;
  59.   howMuch:= 10;
  60.   colStart:= 0;
  61.   xDim:= 24;
  62.   IF (xDim MOD 4) # 0 THEN
  63.     HALT (* wir wollen immer ganze Longwords haben! *)
  64.   END;
  65.   yDim:= 24;
  66.   
  67.   FOR c:= 1 TO 20 DO WriteLn END;
  68.   
  69.   minPlot:=256; maxPlot:=0;
  70.   
  71.   Open(inFile,inName,readOnly);
  72.   (* Seek (inFile, skip, fromBegin); *)
  73.   Create (out1File, out1Name, writeOnly, replaceOld);
  74.  
  75.   FOR count:=0 TO howMuch-1 DO
  76.     long:= LONG (xDim) * LONG (yDim) * 2;
  77.     ALLOCATE (shape, long);
  78.     FilledRectangle (Point{0,0}, Point{200,200});
  79.     y:=0; x:=0;
  80.     FOR line:=0 TO yDim-1 DO
  81.       FOR row:=0 TO xDim-1 DO
  82.         ReadByte(inFile,b);
  83.         c:= ORD(b);
  84.         SetPix (x,y,c);
  85.         INC(x,4);
  86.         IF x>=xDim THEN
  87.           DEC(x,xDim);
  88.           INC(y);
  89.           IF y>=yDim THEN DEC(y,yDim); INC(x) END;
  90.         END;
  91.       END;
  92.     END;
  93.     (*
  94.     Read (ch);
  95.     IF ch = CHR(27) THEN
  96.       RETURN
  97.     END;
  98.     *)
  99.     WriteBytes (out1File, shape, long);
  100.     DEALLOCATE (shape, long);
  101.   END;
  102.   Close(out1File);
  103.   Close(inFile);
  104.   
  105. END ShpConvert.
  106. ə
  107. (* $FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$00000A31$FFE5C2D0$00000ABA$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0$FFE5C2D0Ç$00000A31T.......T.......T.......T.......T.......T.......T.......T.......T.......T.......$0000069D$000009E7$00000A31$0000061D$000005ED$000005C3$0000069D$FFE5C2D0$00000672$0000059B$FFE5C2D0$FFE5C2D0$00000069$0000059B$000005CB$0000061DîÇÇ*)
  108.